Delphi --- Sekalaiset 3

VUOSI 2002
// täysin kotimaisella SANANMUUNNOSOHJELMAN koodilla, joten
// ulkomaalaisille tämä ei ehkä "avaudu", mutta matalaotsaiselle, katalakatseiselle
// suomalaiselle voi tulla hymynvire suupieleen kun kirjoittaa Edit1:seen
// vaikkapa PEKKA KAUKALOSSA tms. Jos sanoja on kolme, niin ne pitää liittää alaviivalla
// yhteen esim. JUNTTI_JA HIPPI. Vain yksi välilyönti lauseeseen.

// formilla kaksi Edittiä joitten
// CharCase --> ecUpperCase
// Width --> 177
// tumpelosuoja: Edit2:sen ReadOnly --> True

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls;

type
TForm1 = class(TForm)
Edit1: TEdit;
Edit2: TEdit;
procedure Edit1Change(Sender: TObject);
procedure Edit1KeyPress(Sender: TObject; var Key: Char);
procedure Edit1KeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
procedure Edit2Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;
muuttunut,onkoekapitk,onkotokapitk: Boolean;
kokosana,sana1,sana2,s1etu,s1taka,s2etu,s2taka : string;
luku: Integer;
v1,v2,eka,toka,k1,jono,avattu : string;
pit,pit2,kat,kat2,ero,ero2,kaikki,onko : integer;
ekak,tokak : Char;

implementation

{$R *.DFM}

procedure TForm1.Edit1Change(Sender: TObject);
begin
  kokosana := Edit1.Text ;
  pit2 := Length(kokosana);
  kat2 := Pos(' ',kokosana);
  ero2 := pit2 - kat2;
    if kat2 > 2 then //pitää olla 3
    begin
      if ero2 > 1 then
        begin
          onkoekapitk := false;
          onkotokapitk := false;
          luku := Pos(' ',kokosana); //etsitään välilyönti
          sana1 := Copy(kokosana, 1, luku-1); //erotetaan ensimmäinen sana
          sana2 := Copy(kokosana, luku+1, 30); //erotetaan toinen sana
          ekak := sana1[1]; //mikä on ensimmäisen sanan eka kirjain
          tokak := sana2[1];//mikä on toisen sanan eka kirjain
          if (ekak in ['A','a','E','e','I','i','U','u','O','o','Y','y','Ä','ä','Ö','ö'])
          and (sana1[2] = ekak) then onkoekapitk := True;

if (sana1[2] in ['A','a','E','e','I','i','U','u','O','o','Y','y','Ä','ä','Ö','ö'])
then begin
if sana1[2] = sana1[3] then onkoekapitk := True;
end;
if (tokak in ['A','a','E','e','I','i','U','u','O','o','Y','y','Ä','ä','Ö','ö'])
and (sana2[2] = tokak) then onkotokapitk := True;

if (sana2[2] in ['A','a','E','e','I','i','U','u','O','o','Y','y','Ä','ä','Ö','ö'])
then begin
if sana2[2] = sana2[3] then onkotokapitk := True;
end;
if (ekak in ['A','a','E','e','I','i','U','u','O','o','Y','y','Ä','ä','Ö','ö'])
then begin
       //jos alkaa vokaalilla then
       if onkotokapitk then
       s1etu := Copy(sana1, 1, 1)+ekak else
       s1etu := Copy(sana1, 1, 1); //eka sanan etuosa
       if onkoekapitk then
       s1taka := Copy(sana1, 3, 25) else
       s1taka := Copy(sana1, 2, 25);//eka sanan takaosa
     end
else
  begin
    //jos EI ala vokaalilla then
    if onkotokapitk then
    s1etu := Copy(sana1, 1, 2)+sana1[2] else
    s1etu := Copy(sana1, 1, 2); //eka sanan etuosa

    if onkoekapitk then //jos ekasanassa pitkä vokaali
    s1taka := Copy(sana1, 4, 25) else //poistetaan ekasanasta vielä yksi kirjain
    s1taka := Copy(sana1, 3, 25);
end;

if (tokak in ['A','a','E','e','I','i','U','u','O','o','Y','y','Ä','ä','Ö','ö'])
then begin //jos alkaa vokaalilla then
       if onkoekapitk then
       s2etu := Copy(sana2, 1, 1)+tokak else
       s2etu := Copy(sana2, 1, 1); //toka sanan etuosa

if onkotokapitk then
  s2taka := Copy(sana2, 3, 25) else
  s2taka := Copy(sana2, 2, 25);//toka sanan takaosa
end
 else
begin
  //jos EI ala vokaalilla then
  if onkoekapitk then
  s2etu := Copy(sana2, 1, 2)+sana2[2] else
  s2etu := Copy(sana2, 1, 2);

  if onkotokapitk then //jos tokasanassa pitkä vokaali
  s2taka := Copy(sana2, 4, 25) else
  s2taka := Copy(sana2, 3, 25);
end;
Edit2.Text := s2etu + s1taka +' '+s1etu + s2taka;
end
else
  begin
    Edit2.Text := '';
  end;
end
else
  begin
    Edit2.Text := '';
  end;
end;//Edit1Change

procedure TForm1.Edit1KeyPress(Sender: TObject; var Key: Char);
var T: string;
begin
  if Key = chr(32) then //ei kahta välilyöntiä
    begin
      T := Edit1.Text;
      if Pos(' ', T) > 0 then key := #0;
    end;
end;

procedure TForm1.Edit1KeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
  if key = VK_DELETE then
    begin
      Edit1.Clear; //putsataan editit
      Edit2.Clear;
    end;
end;

procedure TForm1.Edit2Click(Sender: TObject);
begin
  Edit1.SetFocus; //Jos tumpelo klikkaa Edit2:seen, focus 1:seen
end;

end.
// HUH, olipa pitkä ja hankala tarkistaa toimiiko tuo ollenkaan??!!.
// Lepuutetaan hermoja Jimi Hendrixin "Message to the universe" kappaleella
// ja nappulat kaakkoon.
Voit siirtää formilla olevia "komponentteja" pikseli kerrallaan:
Valitse yksi tai useampi "komponentti", paina Ctrl pohjaan...
pidä pohjassa ja liikuta nuolinäppäimillä.

Voit myös muuttaa valitun "komponentin" kokoa nuolinäppäimillä pitämällä 
Vaihto (Shift) näppäin pohjassa.
//Jos sovelluksessa on vain yksi edit, ja enterin painalluksella Windows "piippaa"
//laita Edit1KeyPressin viimeiseksi riviksi: if key = Char(VK_RETURN) then Key := #0;
procedure TForm1.Edit1KeyPress(Sender: TObject; var Key: Char);
  begin
    //koodia
    //...
    //...
    if Key = #13 then
      begin
        //vaikka enter on käytössä
      end;
     //...
     //...
     //...
    if key = Char(VK_RETURN) then Key := #0; //ärsyttävä windowsin ääni pois
  end;
//Vain salasanalla ohjelma käyntiin. Ohjelmassa vain yksi formi,
InputBox:illa kysytään salasana ja MessageDlg:llä herjataan väärästä.( 9.2.2002 )
unit sala1; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, Mask; type TForm1 = class(TForm) procedure FormCreate(Sender: TObject); procedure FormActivate(Sender: TObject); private { Private declarations } public { Public declarations } end; var Form1: TForm1; annettu_salasana : string; //sisäänpyrkijän salasana const Salasana = 'jiihaa'; //salasana implementation {$R *.DFM} procedure TForm1.FormCreate(Sender: TObject); //FormGreateen begin annettu_salasana := InputBox('Tarkistus', 'Kirjoita salasana', ''); if annettu_salasana <> Salasana then begin MessageDlg('VÄÄRÄ SALASANA, POISTU OHJELMASTA', mtInformation, [mbOk], 0); end; end; procedure TForm1.FormActivate(Sender: TObject); //FormActivateen begin if annettu_salasana <> Salasana then Application.Terminate; //suljetaan ohjelma end; end.
//Jos joku tapahtuma pitää olla kahden näppäimen takana,
tässä Ctrl + F12, laita KeyDowniin:
procedure TForm1.Edit1KeyDown(Sender: TObject; var Key: Word; //KeyDown:iin Shift: TShiftState); begin //... //... if ((Shift = [ssCtrl]) and (key = VK_F12)) then //huom. sulut!! begin //jos Ctrl on pohjassa ja näpätään F12 end; //... //... end; //Shift:in muut arvot: //ssShift, ssAlt, ssCtrl, ssLeft, ssRight, ssMiddle, ssDouble
// Käynnistää tietokoneen uudelleen
ExitWindowsEx( EWX_REBOOT, 0 );
Jos haluat että sovelluksesi on sekä 95, 98, ME että XP yhteensopiva,
älä käytä clNone värimääritystä. XP näyttää esim. Radio Button komponentin täysin mustana???
Etsit jonkun ohjelman oikeaa nimeä esim: Muistio = NOTEPAD.EXE ja 
Rekisterieditori = regedit.exe, ja haluat löytää vaikka XP:ssä olevan OnScreen näppäimistön "oikean" nimen. Käynnistä Delphin apuohjelma WinSight. Tämä windowsin viestien vakoiluohjelma (ws32.exe) näyttää rivin: Overlapped 00140520 {OSKMainClass} osk.EXE (352,534)-(964,729) "OnScreen-näppäimistö". Vapaasti suomennettuna: Overlapped = tavanomainen ikkuna, tyyli WS_OVERLAPPED, 00140520 = ikkunan kahva (HWND)? {OSKMainClass} = luokkanimi osk.EXE = ohjelman nimi (352,534)-(964,729) = ikkunan koko ja asema "OnScreen-näppäimistö" = ikkunan otsikkorivin teksti. Tästä voi päätellä että ohjelman oikea nimi on osk.exe. Testaa vielä nimi Käynnistä, suorita ja kirjoita osk -> ok
Kuvitellaan että tarvitaan kolme vierekkäistä RadioButton1 komponenttia RadioGroup1:in sisään

Pudota RadioGroup1 formille ja nimeä se.

Avaa Object Inspectorissa RadioGroup1:en Items ominaisuudesta String List editor.

Kirjoita kolme riviä(kolme RadioButtonia), eli annat nyt nimet RadioButtoneille.
Niin monta RadioButtonia luodaan, kuinka monta riviä kirjoitat.
Kirjoita vaikka:

Eka
Toka
Kolmas

Paina OK, RadioGroupissa on nyt kolme päällekkäistä RadioButtonia.
Takaisin Object Inspectoriin, RadioGroup1:en Columns arvoa muuttamaan.
Arvolla 1 RadioButtonit on päällekkäin, 2:sella "hajallaan", 3:sella vierekkäin,
4:sella ja sitä suuremmalla RadioButtoneiden väli pienenee.

Testaa että kaikki on kunnossa, vetämällä RadioGrouppia, jos RadioButtonit pysyy mukana,
niin kaikki on ok.

Vielä pitäisi laittaa vaikka Toka RadioButton oletuksena päälle,
laita RadioGroup1:en ItemIndex arvoksi 1 (0 on eka), kuittaa enterillä.
//Tulostaa txt tiedoston muistiolla niin, ettei naapurin "Erkkikään" tiedä
  millä se tulostettiin (SW_HIDE). Tosin Eki voi päätellä sivunumeroinnista
  ym. jotain häikkää...Laita uses rimpsuun ShellApi, niin toimii hiukan paremmin.

procedure TForm1.SpeedButton3Click(Sender: TObject);
  begin
    ShellExecute(Handle, 'print', 'esim.txt', nil, nil, SW_HIDE);
  end;
//Formilla ListBox ja nappi.
Jos ListBox:issa on valittuna esim www.canon.fi (eihän ole mainontaa?) niin käynnistetään selain ja otetaan yhteys ko. sivulle.
Toimii myös jos rivinä on http alkuinen, vaikkapa http://netti.nic.fi/~perpo. 12.03.2003
procedure TForm1.SpeedButton1Click(Sender: TObject); var jono: array[0..79] of Char; begin if ListBox1.ItemIndex >= 0 then begin // jos rivejä if ListBox1.items[ListBox1.ItemIndex]<> '' then begin //jos jotain StrPCopy(jono, ListBox1.items[ListBox1.ItemIndex]); ShellExecute(Handle, nil, jono, '', '', SW_SHOWNORMAL); end; //jos jotain end; // jos rivejä end; //Tähänkin pitää laittaa uses rimpsuun ShellApi.
//Pariton vai parillinen luku ?

if odd(StrToInt(FloatToStr(PVMErotus))) then //vaihda odd() sulkujen sisältö!!
  begin
    // pariton
  end
else
  begin
    // parillinen
  end;
( imuroi --> WWW-apu ohjelma* 326 kt ),jota voi hyödyntää 
esim. laskujen maksamisessa (leikepöytä). Tympii kirjoitella samoja sanoja: ajoneuvohallintokeskus, sanoma magazines finland, sonera entrum oy, ym. ym. Tai voit pitää ohjelmaa korpulla ja surffalla suosikkisivuille mistä vain (Suosikit aina mukana). Toimii vain jos ne on muotoa www tai http:// alkuisia. Kukapa muistaa jotain sivua (vaikkapa www.webmobil24.de/web/fi/start/p/index.htm)
kirjastossa. Tosin jos kirjastotäti huomaa, että tunkaset USB-pulikan heidän koneeseen,
voi kirjastotädin kengänkärki ja WWW-apu ohjelman käyttäjän häntäluu kohdata
tuhoisin seurauksin. Ohjelmassa on myös kalenteri, (tai oikeammin päivien poimintakomponentti) jossa on kaksi eri päivienlaskentaa. Joko aina kuluvasta päivästä johonkin tai itse määrätyistä päivistä. Voit katsoa montako päivää vielä on jäljellä, ennen kuin seuraavaan kerran "pähkinäpussi" maksetaan tilillesi. WWW-apu ohjelma toimii vain alustalla johon voi kirjoittaa, korppu tai kiintolevy. Johtuen kahdesta txt-tiedostosta ( ppvm.txt ja wwwapu.txt ) joita ohjelma käyttää. Tiedostoon ppvm.txt tallennetaan ensimmäinen pistospäivämäärä. Jonka jälkeen ohjelma näyttää (muistuttaa) joka toinen päivä kuvakkeella onko pistospäivä vai ei. Betaferon, ei huumeet ;-) Tallennuksesta ei tarvitse huolehtia mitenkään. * versio 0.0.0.3 6.6.2003 -Lisätty mm. ominaisuus, joka erottaa ensimmäinen merkkijonon ennen välilyöntiä ja vie sen leikepöydälle. Ominaisuutta voi käyttää esim. netistä tilatessa. Useinhan niissä on tilausnumero, jolla tuotetta voi sivuilta hakea ja tilata. Jos listassasi on tallennettuna vaikkapa: 153757 Marshall MG100DFX guitars Combo, 100 Watts, napilla voit erottaa leikepöydälle vain tuon tilausnumeron. * versio 0.0.0.4 13.1.2004 XP versio + pieniä korjauksia -Selkeytetty rakennetta, suosikit tallennetaan erikseen. Lisätty mm. ominaisuus käynnistellä omia, tarpeellisiksi katsomiaan ohjelmia* wwwapu-ohjelmasta. Eli nyt *.txt tiedostoja on neljä: ppvm.txt, wwwapu.txt, ohjelmat.txt ja suosikit.txt Ohjelma.exe nimen jälkeen voi nimeä "kommentoida", eli luetaan vain ensimmäiseen välilyöntiin asti.(esim: uba.exe Laskee onko ylä-vaiko alamäkiä enemmän) Otetaan allaoleva USB-muisti, ladataan ohjelmat palikkaan ja siirrytään koneelle jossa on nopea internetyhteys. Nyt vain USB-muisti koneeseen kiinni ja ledi välkkymään. *Käynnistettävä ohjelma pitää olla samassa kansiossa kuin pääohjelma.
//Trim funktiolla eroon välilyönneistä merkkijonon etu- ja takapuolelta
procedure TForm1.BitBtn1Click(Sender: TObject);
var mjono: String;
  begin
    mjono := '  joopa joo  '; // merkkijono
    Edit1.Text := trim(mjono); //= 'joopa joo'
  end;
Labelille ja StaticTextille ei tulostu & merkkiä, vaan alaviiva _??
- Laita ShowAccelChar arvo Object Inspectorissa Falseksi.
//Nappulan teksti päällekkäin 14.2.2004

procedure Tmain.FormCreate(Sender: TObject); //Pääformin Greateen
 begin
   nappi.Caption := 'Eka rivi' + #10 + 'Toka rivi';
 end;
//Lyhyt ohjelma ympyrän piirtämiseen



procedure TForm1.Button1Click(Sender: TObject);
var
X,Y,S,K,L,f,g,kulma : Integer;
begin
X:=200; //ympyrän keskipiste vaakas.
Y:=200; //ympyrän keskipiste pystys.
S:=150; //ympyrän säde.
K:=90; //kaaren alku asteina
L:=360; //kaaren loppu asteina
Canvas.Pen.Width:=1;
Canvas.Pen.Color:= clRed;

Canvas.MoveTo(X,Y); // siirretään kohdistin ympyrän keskelle

For kulma := K to L do
begin

f:=Round(cos(((2*pi*kulma)/360))*S); // Y

g:=Round(sin(((2*pi*kulma)/360))*S); // X

Canvas.LineTo(X+g,Y-f);

/// // Canvas.Pixels[X+g,Y-f]:= clred;
end;
end;