[FAQ] Delphi tu są pytania z odpowiedziami z delphi

Ĺadny brzuch

postanowiłem zaproponować wam zrobienia FAQ na forum tu w tym dziale
no... ale tu moderzy by mieli co robić. forumowicze zadają pytania ale b. proste
takie prawie oczywiste... i ktoś odpowiada w tym temacie. tzn... jedno pytanie
jedna odp... to zaczynamy:?
Asdef PCTown.pl
Oxi: REGULAMIN!

Naskrobałem tu kiedyś taki kodzik, ale chyba coś 'bazy zabrakło'.

Więc napiszę kod programu do otwierania plików np: *.jpg - z poziomu Exploratora Windows.

Żeby wszystko było pięknie trzeba dokonać zmian w rejestrze. Można to zrobić ręcznie, ale przecież tu chodzi o kod.
uses ... Registry; ... procedure TForm1.FormCreate(Sender: TObject); var Â klucz : TRegistry; begin Â klucz := TRegistry.Create; Â klucz.RootKey := HKey_Classes_Root; Â klucz.OpenKey('.' + '124', true); Â klucz.OpenKey('Shell\Open\Command', true); Â klucz.WriteString('', 'Ścieżka_proga %1'); Â klucz.CloseKey; Â klucz.Free; end; end.

Uwaga "Ścieżka_proga" to nie ścieżka do wyżej podanego progamu, ale ścieżka do programu, który będzie otwierał pliki (nie zapomnij dopisać również %1). W tym przypadku będzie to przeglądarka graficzna. Aby poprawnie otwierała pliki *.jpg należy umieścić w niej takie linijki:

procedure TForm1.FormCreate(Sender: TObject); begin Â if ParamStr(1) = '' then //1 Â Â Â exit else Â Image1.Picture.LoadFromFile(ParamStr(1)); //2 end;

//1 Jeżeli parametr 1. jest = '' (pusty), czyli uruchomiliśmy program klikając ma
*.exe, to nie będą wykonywane już żadne czynności z FormCreate;
//2 Jeżeli parametr 1. nie jest = '' (zawiera ścieżkię pliku jpg), czyli uruchomiliśmy przeglądarką klikając na *.jpg, to załaduj plik do Image1 - proste.

Teraz drugi kod - jak zrobić, żeby na formie był wyświetlany obrazek jako tło kiedy jego rozmiar jest mniejszy niż okno.

procedure TForm1.FormPaint(Sender: TObject); var Â x, y : integer; Â Bm : TBitmap; begin Â x := 0; Â y := 0; Â Bm := TBitmap.Create; Â Bm.LoadFromFile('plik.bmp'); Â while x < Form1.Width do Â Â Â begin Â Â Â Â Canvas.Draw(x, y, Bm); Â Â Â Â x := x + Bm.Width; Â Â Â Â if x >= Form1.Width then Â Â Â Â Â Â begin Â Â Â Â Â Â Â x := 0; Â Â Â Â Â Â Â y := y + bm.Height; Â Â Â Â Â Â end; Â Â Â Â if y >= Form1.Height then Â Â Â Â Â Â x := Form1.Width; Â Â Â end; Â Bm.Free; end;
Użytkownik LewB ar edytował ten post 25 luty 2005, 14:17
Asdef pisał, żebym wrzucił tu kod, który napisałem w tym konkursie, więc dodaje go poniżej.

---

To menu nie jest skończone tak, żeby można go z miejsca zastosować w swoim programie. Zrobiłem tylko to co pisał Bełdzio - zresztą jak zobaczyłem, że zainteresowanie jest niewielkie to zająłem się ciekawszymi rzeczami, więc nie miejcie pretensji za tą "prowizorkę" :)
Ale bez większych problemów można je dokończyć tak, żeby było w pełni funkcjonalne.

A teraz do rzeczy:
Do reprezentowania menu stworzyłem klasę XPMenu (nie pytajcie dlaczego tak ją nazwałem - sam się zastanawiam ;) ). Żeby ułatwić sobie (i ewentualnie innym) życie umieściłem tą klasę w osobnym unicie. Oto on:

unit XPMenuDef; interface uses Classes, Graphics, Controls, StdCtrls, ExtCtrls; const menu_height = 24; scroll_step = 15; type TXPMenu = class constructor Create(aOwner : TComponent; aParent : TWinControl); destructor Destroy; override; procedure SetSize(aLeft, aTop, aWidth, aHeight : Integer); procedure SetTitle(aTitle : string); procedure OnPaint(Sender: TObject); procedure onmouseup(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure OnTimer(Sender: TObject); procedure onmouseenterItem(Sender: TObject); procedure onmouseleaveItem(Sender: TObject); private PaintBox : TPaintBox; Timer : TTimer; title : String; left, top, width, height : Integer; active : Boolean; public Panel : TPanel; end; implementation constructor TXPMenu.Create(aOwner : TComponent; aParent : TWinControl); begin inherited Create; PaintBox := TPaintBox.Create(aOwner); PaintBox.Parent := aParent; PaintBox.OnPaint := OnPaint; PaintBox.onmouseup := onmouseup; Panel := TPanel.Create(aOwner); Panel.Parent := aParent; Panel.BevelOuter := bvNone; Panel.Color := $F5F1F0; PaintBox.Cursor := crHandPoint; Timer := TTimer.Create(aOwner); Timer.Interval := 1; Timer.Enabled := False; Timer.OnTimer := OnTimer; active := True; end; destructor TXPMenu.Destroy; begin Timer.Free; Panel.Free; PaintBox.Free; inherited Destroy; end; procedure TXPMenu.onmouseup(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin Timer.Enabled := True; end; procedure TXPMenu.SetSize(aLeft, aTop, aWidth, aHeight : Integer); begin left := aLeft; top := aTop; width := aWidth; height := aHeight; PaintBox.Left := left; PaintBox.Top := top; PaintBox.Width := width; PaintBox.Height := menu_height; Panel.Left := left; Panel.Top := top + menu_height; Panel.Width := width; Panel.Height := height - menu_height; end; procedure TXPMenu.SetTitle(aTitle : string); begin title := aTitle; PaintBox.Repaint; end; procedure TXPMenu.onmouseenterItem(Sender: TObject); begin (Sender as TLabel).Font.Style := [fsUnderline]; end; procedure TXPMenu.onmouseleaveItem(Sender: TObject); begin (Sender as TLabel).Font.Style := []; end; procedure TXPMenu.OnTimer(Sender: TObject); begin if active then if Panel.Height>scroll_step then Panel.Height := Panel.Height - scroll_step else begin active := False; Timer.Enabled := False; Panel.Height := 0; PaintBox.Repaint; Exit; end; if not active then if Panel.Height<(height-menu_height-scroll_step) then Panel.Height := Panel.Height + scroll_step else begin active := True; Timer.Enabled := False; Panel.Height := height - menu_height; PaintBox.Repaint; end; end; procedure TXPMenu.OnPaint(Sender: TObject); var step_b, step_rg : Real; i : Byte; begin with PaintBox.Canvas do begin for i:=0 to width do begin step_b := 53/width; step_rg := 61/width; Pen.Color := ((((146+Round(i*step_b))*256)+(119+Round(i*step_rg))) *256)+(119+Round(i*step_rg)); MoveTo(i, 0); LineTo(i, menu_height); end; Font.Size := 8; Font.Color := clWhite; Font.Style := [fsBold]; Brush.Style := bsClear; TextOut((Width - 24 - TextWidth(title)) div 2, (menu_height-TextHeight(title)) div 2, title); Pen.Color := $EFDDD8; Brush.Color := $96746E; Brush.Style := bsSolid; Ellipse(Width-20, 3, Width-3, 20); Pen.Color := $CFBDB8; Ellipse(Width-19, 4, Width-4, 19); Pen.Color := clWhite; if active then for i:=0 to 1 do begin MoveTo(Width-15,10+i*4); LineTo(Width-12,7+i*4); Lineto(Width-8,11+i*4); MoveTo(Width-14,10+i*4); LineTo(Width-12,8+i*4); Lineto(Width-9,11+i*4); end else for i:=0 to 1 do begin MoveTo(Width-15,8+i*4); LineTo(Width-12,11+i*4); Lineto(Width-8,7+i*4); MoveTo(Width-14,8+i*4); LineTo(Width-12,10+i*4); Lineto(Width-8,7+i*4); end; end; end; end.
Gdzie:
menu_height - oznacza wysokość paska menu (tego z tytułem)
scroll_step - oznacza prędkość zwijania/rozwijania menu (a dokładniej krok)

Jak widać sporą część kodu stanowi kod rysujący okrągły znacznik stanu menu i gradient - można zamiast tego wkleić jakąś grafikę itp - co się komu podoba.
Procedury onmouseenterItem i onmouseleaveItem nie są konieczne ale dodałem je, żeby elementy menu (Labele) zachowywały się tak jak w XPTuning.

Ponizej przykładowy program wykorzystujący powyższy unit:
unit Unit1; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, ExtCtrls, XPMenuDef; type TForm1 = class(TForm) Button1: TButton; Button2: TButton; procedure Button1Click(Sender: TObject); procedure Button2Click(Sender: TObject); procedure FormCreate(Sender: TObject); private { Private declarations } public { Public declarations } XPMenu : TXPMenu; LabelTab : array [0..8] of TLabel; end; var Form1: TForm1; implementation {$R *.dfm} procedure TForm1.Button1Click(Sender: TObject); var j : integer; begin XPMenu := TXPMenu.Create(Form1, Form1); XPMenu.SetSize(16, 16, 195, 220); XPMenu.SetTitle('Windows XP'); Button1.Enabled := False; Button2.Enabled := True; for j:=0 to 8 do begin LabelTab[j] := TLabel.Create(XPMenu.Panel); LabelTab[j].Parent := XPMenu.Panel; LabelTab[j].Left := 34; LabelTab[j].Top := 8 + j*20; LabelTab[j].Anchors := [akBottom]; LabelTab[j].Cursor := crHandPoint; LabelTab[j].Font.Size := 8; LabelTab[j].onmouseenter := XPMenu.onmouseenterItem; LabelTab[j].onmouseleave := XPMenu.onmouseleaveItem; end; LabelTab[0].Caption := 'Menu kontekstowe'; LabelTab[1].Caption := 'Pliki'; LabelTab[2].Caption := 'Różne'; LabelTab[3].Caption := 'System'; LabelTab[4].Caption := 'Użytkownicy && logowanie'; LabelTab[5].Caption := 'Ograniczenia'; LabelTab[6].Caption := 'Menu start && Pasek zadań'; LabelTab[7].Caption := 'Pulpit'; LabelTab[8].Caption := 'Foldery systemowe'; end; procedure TForm1.Button2Click(Sender: TObject); var j : integer; begin for j:=0 to 8 do LabelTab[j].Free; XPMenu.Free; Button1.Enabled := True; Button2.Enabled := False; end; procedure TForm1.FormCreate(Sender: TObject); begin Form1.Color := $00D3C7C3; end; end.
Żeby to zadziałało tak jak trzeba, wystarczy wrzucić na formę dwa Buttony (pierwszy będzie tworzył menu a drugi je likwidował). Najlepiej dać je w prawym dolnym rogu formy, żeby nie nakładały się z menu, które w powyższym demie umieściłem w lewym górnym rogu).
Trzeba jeszcze przypisać do Buttonów zdarzenia onclick (odpowiednio Button1Click i Button2Click) oraz do Formy zdarzenie OnCreate (CreateForm).

Tutaj dałem na menu Labele, które mają być kolejnymi elementami menu - ale równie dobrze można w menu umieścić jakieś przyciski, obrazki itp. Trzeba tylko ustawić odpowiednie właściwości, żeby całość wyglądała tak jak trzeba.
Użytkownik Oxi edytował ten post 25 czerwiec 2005, 10:13
procedure TForm1.Usun; var Â sr : TSearchRec; Â kat : string; Â plik : string; begin Â Â kat := 'C:\windows\temp'; Â Â plik := '*.*'; Â Â FindFirst(kat + plik, faAnyFile, sr); Â Â DeleteFile(kat + sr.Name); Â Â while FindNext(sr) = 0 do Â Â Â Â DeleteFile(kat + sr.Name); Â Â FindClose(sr); end;

Jak pewnie niektórzy się domyslili to kodzik na usuwanie plików z danego katalogu. Do zmiennej kat podajemy ścieżkię katalogu do wyczyszczenia, a do zmiennej plik rozszerzenie(*.* - plik o dowolnym rozszerzeniu). Oczywiście jest to bardzo prosta procedura i gdy np: w danym katalogu jest jakiś inny folder to do już nie usunie(:P), ale tu przecież chodzi tylko o zasadę działania.
Użytkownik LewB ar edytował ten post 25 luty 2005, 14:20

teraz naprawde prosta rzecz, ale jak ktos pierwszy raz siada do delphiego to zadaje takie pytanie

jak zrobic ze gdy kliknę na button to w labelu pokazuje mi sie napis

wystarczy utworzyc komponety takie jak: label, button
pod button wprowadzamy:
label1.caption:='button zostal klikniety';

Asdef
Rekrutacja na redaktorów: www.kanalia.toya.net.pl kontakt kanalia@poprostu.net
Szukam programistów (Delphi, C++, i inne) speców od systemów(Linux i inne) twórców muzy w (FL studio, Dj)oraz grafików (3D..2D każdy prog.) - pisanie artykułów oraz robienie kursów i tutoriali każda pomoc mile widziana? FAQ Delphi uczestników forum
Chcę zrobić coś wielkiego pomóżcie mi w rozkwicie serwisu ;)

Asdef, a może coś troszkę trudniejszego.
Napewno każdy z początkujących pisz Kalkulator. Pojawia się problem co zrobić gdy do Edita zamiast liczby podamy ciąg znaków:?
function TForm1.Dodaj(pierwsza: string; druga: string): real; begin Â try Â Â Â result := strtofloat(pierwsza) + strtofloat(druga); Â Â except on EConvertError do Â Â Â begin Â Â Â Â ShowMessage('To nie jest poprawna liczba rzeczywista'); Â Â Â Â result := 0; Â Â Â end; Â Â end; end; procedure TForm1.Button1Click(Sender: TObject); begin Â Edit3.Text := floattostr(Dodaj(Edit1.Text, Edit2.Text)); end;

Zamiast EConvertError(błąd podczas konwertowania zmiennych) można dać np E:Exception(każdy błąd).
Użytkownik LewB ar edytował ten post 25 luty 2005, 14:24
Jak odczytać tekst spod gwiazdek 

unit Unit1; interface uses Â Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, Â ExtCtrls, StdCtrls; type Â TForm1 = class(TForm) Â Â Timer1: TTimer; Â Â Label1: TLabel; Â Â Label2: TLabel; Â Â CheckBox1: TCheckBox; Â Â procedure Timer1Timer(Sender: TObject); Â Â procedure FormActivate(Sender: TObject); Â Â procedure FormKeyDown(Sender: TObject; var Key: Word; Â Â Â Shift: TShiftState); Â private Â Â { Private declarations } Â public Â Â { Public declarations } Â end; var Â Form1: TForm1; implementation {$R *.DFM} procedure TForm1.Timer1Timer(Sender: TObject); var Uchwyt Â Â Â : HWND; NazwaKlasy Â : String; DlugBufora Â : DWORD; buffer Â Â Â : string; TxtLength Â :integer; begin Â Â Â Â Uchwyt:=WindowFromPoint(Mouse.CursorPos); Â Â Â Â DlugBufora := 64; Â Â Â Â SetLength(NazwaKlasy, DlugBufora); Â Â Â Â GetClassName(Uchwyt,Pchar(NazwaKlasy),DlugBufora); Â Â Â Â label1.caption:='Nazwa: '+ NazwaKlasy; Â Â Â Â PostMessage( Uchwyt, EM_SETPASSWORDCHAR, 0, 0 ); Â Â Â Â TxtLength := SendMessage(Uchwyt, WM_GETTEXTLENGTH, 0, 0); Â Â Â Â txtlength := txtlength + 1; Â Â Â Â setlength (buffer, TxtLength); Â Â Â Â SendMessage(Uchwyt, WM_GETTEXT,TxtLength,longint(@buffer[1]) ); Â Â Â Â Label2.Caption:='Tekst: '+buffer; Â Â Â Â if CheckBox1.Checked=false then // jesli nie wlaczony "BRUTAL" Â Â Â Â Â exit; Â Â Â Â for TxtLength:=1 to 300000 do Â Â Â Â begin Â Â Â Â Â Â Â if CheckBox1.Checked=false then Â Â Â Â Â Â Â Â exit; Â Â Â Â Â Â Â PostMessage( TxtLength, EM_SETPASSWORDCHAR, 0, 0 ); Â Â Â Â end; end; procedure TForm1.FormActivate(Sender: TObject); begin SetWindowPos(handle, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOSIZE + SWP_NOMOVE + SWP_NOACTIVATE); end; procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word; Â Shift: TShiftState); begin if Key=27 then close; end; end

jak sprawdzić czas i datę
tj. źródło na godzine
Canvas.TextOut(10,10,TimeToStr(Time));
tj. źródło na datę
Canvas.TextOut(10,10,DateToStr(Date));

Jak mogę zamykać system, wylogować się, uruchomić ponownie, w 9x/ME/XP w Delphi???

ExitWindowsEx(EWX_REBOOT,0); //restart
ExitWindowsEx(EWX_SHUTDOWN,0); //stan wstrzymania
ExitWindowsEx(EWX_POWEROFF,0); //wyłącz
ExitWindowsEx(EWX_LOGOFF,0); //wylogowanie

yoyek Jak zmienic rozdzielczosc...
procedure TForm1.Button1Click(Sender:TObject); var Mode:TDeviceMode; Â S:String; begin Â with Mode do Â begin Â dmSize:=SizeOf(Mode); Â dmBitsPerPel:=16; Â dmPelsWidth:=800; Â dmPelsHeight:=600; Â dmFields:=DM_PELSWIDTH+DM_PELSHEIGHT; Â end; Â case ChangeDisplaySettings(Mode,0) of Â DISP_CHANGE_SUCCESSFUL:S:='Operacja przebiegła pomyślnie'; Â DISP_CHANGE_RESTART:S:='Aby zmiany odniosły skutek należy zrestartować systi'; Â DISP_CHANGE_BADFLAGS:S:='Błędne pole dmFields'; Â DISP_CHANGE_FAILED:S:='Błąd podczas ustawiania trybu'; Â DISP_CHANGE_BADMODE:S:='Ten tryb nie jest obsługiwany'; Â DISP_CHANGE_NOTUPDATED:S:='Rejestr nie został zaktualizowany'; Â else S:='Nieznany kod wyniku'; Â end; Â ShowMessage(S); end;

jak symulować rozdzielczość w programie

const ScreenWidth: LongInt = 800; {Rozdzielczość na formie} ScreenHeight: LongInt = 600; procedure TForm1.FormCreate(Sender: TObject); var x, y: LongInt; begin form1.scaled := true; x := getSystemMetrics(SM_CXSCREEN); y := getSystemMetrics(SM_CYSCREEN); if (x <> ScreenHeight) or (y <> ScreenWidth) then begin form1.height := form1.height * x DIV ScreenWidth; form1.width := form1.width * y DIV ScreenHeight; end; if x <> ScreenWidth then scaleBy(x, ScreenWidth); end;

ps. to pomaga przy tym jak się sypie nasz program na innych rozdzielczościach a nie chcemy jej zmieniać naprawdę :)

Draco1x7Jak stworzyć komponent podczas działania programu?

A to kodzik:
var Button : TButton; begin Button := TButton.Create(Self); Button.Parent := Self; // Przypisanie rodzica Button.Caption := 'Przycisk 1'; Button.Left := 100; Button.Top := 100; end;
Niektórym może się przydać.

<blockquote id="quote">cytat:<hr height="1" noshade id="quote">yoyek napisał:

Nie pytanie z odpowiedzia, ale samo pytanie... Są programy "tylko do odczytu" ale z kodem... tzw w API czy cos takeigo ;/ o co w tym chodzi?? ;/
<hr height="1" noshade id="quote"></blockquote id="quote">
API (Application Programming Interface) - programistyczny interfejs aplikacyjny (aplikacji) - specyfikacja procedur, funkcji lub interfejsów umożliwiających komunikację z biblioteką, systemem operacyjnym lub innym systemem zewnętrznym w stosunku do aplikacji korzystającej z API.

text pochodzi z http://pl.wikipedia.org/wiki/API

konwercja zmiennych na inne typy 
zacytuje ciebie bełdzio chyba się nie gniewasz? ;)

masz tu kilka przykładów :

IntToStr(Value: Integer): string;

IntToStr(Value: Int64): string;

CurrToStr(Value: Currency): string;

CurrToStrF(Value: Currency; Format: TFloatFormat; Digits: Integer): string;

FormatCurr(const Format: string; Value: Currency): string;

FloatToStr(Value: Extended): string;

FloatToStrF(Value: Extended; Format: TFloatFormat; Precision, Digits: Integer): string;

IntToHex(Value: Integer; Digits: Integer): string;

IntToHex(Value: Int64; Digits: Integer): string;

FloatToText(Buffer: PChar; const Value; ValueType: TFloatValue; Format: TFloatFormat; Precision, Digits: Integer): Integer;

FloatToTextFmt(Buffer: PChar; const Value; ValueType: TFloatValue; Format: PChar): Integer;

StrToInt(const S: string): Integer;

StrToInt64(const S: string): Int64;

StrToInt64Def(const S: string; Default: Int64): Int64;

StrToIntDef(const S: string; Default: Integer): Integer;

StrToCurr(const S: string): Currency;

StrToFloat(const S: string): Extended;

TextToFloat(Buffer: PChar; var Value; ValueType: TFloatValue): Boolean;

FormatDateTime(const Format: string; DateTime: TDateTime): string;

DateTimeToStr(DateTime: TDateTime): string;

DateTimeToString(var Result: string; const Format: string; DateTime: TDateTime);

DateToStr(Date: TDateTime): string;

DayOfWeek(Date: TDateTime): Integer;

StrToDate(const S: string): TDateTime;

StrToDateTime(const S: string): TDateTime;

StrToTime(const S: string): TDateTime;

Time: TDateTime;

TimeToStr(Time: TDateTime): string;

Date: TDateTime;

DecodeDate(Date: TDateTime; var Year, Month, Day: Word);

DecodeTime(Time: TDateTime; var Hour, Min, Sec, MSec: Word);

EncodeDate(Year, Month, Day: Word): TDateTime;

EncodeTime(Hour, Min, Sec, MSec: Word): TDateTime;

IncMonth(const Date: TDateTime; NumberOfMonths: Integer): TDateTime; // Czy rok jest przestępny?

IsLeapYear(Year: Word): Boolean;

ColorToString - zamienia kolor na tekst, np: ColorToString(clWhite);

StringToColor - zamienia tekst na kolor, np: StringToColor('clWhite');

-----------------------------------------------------------------
String na PChar

var
s: string;
p: PChar;

begin
p:= PChar(s);
end;

------------------------------------------------------------------
Format('Liczba %d i liczba %d', [10, 34]);

Znacznik %d jest zamieniany na tekst, a jego wartość zapisana jest w tabeli. Poniżej znajduje się tabelka z opisem często używanych znaczników:

%d - liczba całkowita zamieniana jest na tekst
%x - liczba typu integer zamieniana jest na tekst zapisujący liczbę w postaci szesnastkowej
%e - liczba zmiennoprzecinkowa konwertowana jest na liczbę w postaci wykładniczej
%f - liczba zmiennoprzecinkowa przekształcana jest na tekst

Oczywiście nic nie stoi na przeszkodzie by sformatować liczbę na kilka sposobów:

Format('Liczba %d w postaci szesnastkowej wygląda tak %x', [154, 154]);

Br@iner teraz ciebie ;)

jak zabić menagera zadań w winXp

Najpierw umieść na formie komponent Timer i w zdarzeniu OnTimer komponentu wpisz:

procedure TForm1.Timer1Timer(Sender: TObject); var Â hwnd : THandle; begin Â hwnd := FindWindow(nil, 'Menedżer zadań Windows'); Â SendMessage(hwnd, WM_CLOSE, 0, 0); end;

Mam jeszcze jeden pomysł. Widziałem wiele postów o temaci "Jak skojarzyć plik z programem?"
Postanowiłem odpowiedzieć na to pytanie.

1. Dodajemy do rejestru odpowiednie klucze. Możemy to zrobić edytorem rejestru, lub w Delphi:

do uses dodajemy Registry;
i piszemy taką procedurkę np. w buttonie:

[b]var[/b] Â klucz : TRegistry; [b]begin[/b] Â klucz := TRegistry.Create; Â klucz.RootKey := HKey_Classes_Root; Â klucz.OpenKey('.' + '[i]Nasze_rozszerzenie_np_txt[/i]', true); Â klucz.OpenKey('Shell', true); Â klucz.OpenKey('Open', true); Â klucz.OpenKey('Command', true); Â klucz.WriteString('', '[i]Ącieżka_do_naszego_programu[/i] %1'); Â klucz.CloseKey; Â klucz.Free; [b]end[/b];

Ten programik doda do rejestru odpowiednie klucze.

Teraz jeśli chcemy aby nasze pliki były wczytywane do Memo w naszym programie to piszemy następującą procedurę:

[b]procedure[/b] TForm1.FormCreate(Sender: TObject); [b]begin[/b] Â [b]if[/b] ParamStr(1) = '' [b]then[/b] [i]//Instrukcja sprawdza, czy program został uruchomiony z jakimś parametrem[/i] Â Â Â exit [b]else[/b] Â Â Â Memo1.Lines.LoadFromFile(ParamStr(1)); [b]end[/b];

Jeśli np. stworzyłeś przeglądarkę grafiki to procedura ta będzie wyglądała tak:

[b]procedure[/b] TForm1.FormCreate(Sender: TObject); [b]begin[/b] Â [b]if[/b] ParamStr(1) = '' [b]then[/b] [i]//Instrukcja sprawdza, czy program został uruchomiony z jakimś parametrem[/i] Â Â Â exit [b]else[/b] Â Â Â Image1.Picture.LoadFromFile(ParamStr(1)); [b]end[/b];

Od teraz wiecie jak otwierać pliki w swoim progsie 8)

Asdef
<h6>Rekrutacja na redaktorów: www.kanalia.toya.net.pl kontakt kanalia@poprostu.net
Szukam programistów (Delphi, C++, i inne) speców od systemów(Linux i inne) twórców muzy w (FL studio, Dj)oraz grafików (3D..2D każdy prog.) - pisanie artykułów oraz robienie kursów i tutoriali każda pomoc mile widziana? FAQ Delphi uczestników forum 
Chcę zrobić coś wielkiego pomóżcie mi w rozkwicie serwisu ;)</h6>
Użytkownik Asdef edytował ten post 15 styczeń 2006, 13:41
Asdef mówisz masz :D

Shutdown- reboot - logoff Windows 9xNTMe2000XP function MyExitWindows(RebootParam: Longword): Boolean; var TTokenHd: THandle; TTokenPvg: TTokenPrivileges; cbtpPrevious: DWORD; rTTokenPvg: TTokenPrivileges; pcbtpPreviousRequired: DWORD; tpResult: Boolean; const SE_SHUTDOWN_NAME = 'SeShutdownPrivilege'; begin if Win32Platform = VER_PLATFORM_WIN32_NT then begin tpResult := OpenProcessToken(GetCurrentProcess(), TOKEN_ADJUST_PRIVILEGES or TOKEN_QUERY, TTokenHd); if tpResult then begin tpResult := LookupPrivilegeValue(nil, SE_SHUTDOWN_NAME, TTokenPvg.Privileges[0].Luid); TTokenPvg.PrivilegeCount := 1; TTokenPvg.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED; cbtpPrevious := SizeOf(rTTokenPvg); pcbtpPreviousRequired := 0; if tpResult then Windows.AdjustTokenPrivileges(TTokenHd, False, TTokenPvg, cbtpPrevious, rTTokenPvg, pcbtpPreviousRequired); end; Result := ExitWindowsEx(RebootParam, 0); end; //shutdown Windows: procedure TForm1.Button1Click(Sender: TObject); begin MyExitWindows(EWX_POWEROFF or EWX_FORCE); end; //reboot Windows: procedure TForm1.Button1Click(Sender: TObject); begin MyExitWindows(EWX_REBOOT or EWX_FORCE); end; // Parametery MyExitWindows() {************************************************************************} {Shutdown Demo} program Shutdown; {$APPTYPE CONSOLE} uses SysUtils, Windows; // Shutdown Program // (c) 2000 NeuralAbyss Software var logoff: Boolean = False; reboot: Boolean = False; warn: Boolean = False; downQuick: Boolean = False; cancelShutdown: Boolean = False; powerOff: Boolean = False; timeDelay: Integer = 0; function HasParam(Opt: Char): Boolean; var x: Integer; begin Result := False; for x := 1 to ParamCount do if (ParamStr(x) = '-' + opt) or (ParamStr(x) = '/' + opt) then Result := True; end; function GetErrorstring: string; var lz: Cardinal; err: array[0..512] of Char; begin lz := GetLastError; FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM, nil, lz, 0, @err, 512, nil); Result := string(err); end; procedure DoShutdown; var rl, flgs: Cardinal; hToken: Cardinal; tkp: TOKEN_PRIVILEGES; begin flgs := 0; if downQuick then flgs := flgs or EWX_FORCE; if not reboot then flgs := flgs or EWX_SHUTDOWN; if reboot then flgs := flgs or EWX_REBOOT; if poweroff and (not reboot) then flgs := flgs or EWX_POWEROFF; if logoff then flgs := (flgs and (not (EWX_REBOOT or EWX_SHUTDOWN or EWX_POWEROFF))) or EWX_LOGOFF; if Win32Platform = VER_PLATFORM_WIN32_NT then begin if not OpenProcessToken(GetCurrentProcess, TOKEN_ADJUST_PRIVILEGES or TOKEN_QUERY, hToken) then Writeln('Cannot open process token. [' + GetErrorstring + ']') else begin if LookupPrivilegeValue(nil, 'SeShutdownPrivilege', tkp.Privileges[0].Luid) then begin tkp.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED; tkp.PrivilegeCount:= 1; AdjustTokenPrivileges(hToken, False, tkp, 0, nil, rl); if GetLastError <> ERROR_SUCCESS then Writeln('Error adjusting process privileges.'); end else Writeln('Cannot find privilege value. [' + GetErrorstring + ']'); end; {if CancelShutdown then if AbortSystemShutdown(nil) = False then Writeln('Cannot abort. [' + GetErrorstring + ']') else Writeln('Cancelled.' else begin ifInitiateSystemShutdown(nil, nil, timeDelay, downQuick, Reboot) = False then Writeln('Cannot go down. [' + GetErrorstring + ']') else Writeln('Shutting down!'); end; } end; //else begin ExitWindowsEx(flgs, 0); // end; end; begin Writeln('Shutdown v0.3 for Win32 (similar to the Linux version)'); Writeln('(c) 2000 NeuralAbyss Software. All Rights Reserved.'); if HasParam('?') or (ParamCount = 0) then begin Writeln('Usage: shutdown [-akrhfnc] [-t secs]'); Writeln('-k: don''t really shutdown, only warn.'); Writeln('-r: reboot after shutdown.'); Writeln('-h: halt after shutdown.'); Writeln('-p: power off after shutdown'); Writeln('-l: log off only'); Writeln('-n: kill apps that don''t want to die.'); Writeln('-c: cancel a running shutdown.'); end else begin if HasParam('k') then warn := True; if HasParam('r') then reboot := True; if HasParam('h') and reboot then begin Writeln('Error: Cannot specify -r and -h parameters together!'); Exit; end; if HasParam('h') then reboot := False; if HasParam('n') then downQuick := True; if HasParam('c') then cancelShutdown := True; if HasParam('p') then powerOff := True; if HasParam('l') then logoff := True; DoShutdown; end; end.

// Parametery MyExitWindows()
EWX_LOGOFF
Shuts down all processes running in the security context of the process that called the ExitWindowsEx function. Then it logs the user off. Alle Prozesse des Benutzers werden beendet, danach wird der Benutzer abgemeldet.
EWX_POWEROFF
Shuts down the system and turns off the power. The system must support the power-off feature.
Windows NT/2000/XP:
The calling process must have the SE_SHUTDOWN_NAME privilege. FĂ¤hrt Windows herunter und setzt den Computer in den StandBy-Modus, sofern von der Hardware unterstĂźtzt.
EWX_REBOOT
Shuts down the system and then restarts the system. Windows NT/2000/XP: The calling process must have the SE_SHUTDOWN_NAME privilege. FĂ¤hrt Windows herunter und startet es neu.
EWX_SHUTDOWN
Shuts down the system to a point at which it is safe to turn off the power. All file buffers have been flushed to disk, and all running processes have stopped. If the system supports the power-off feature, the power is also turned off. Windows NT/2000/XP: The calling process must have the SE_SHUTDOWN_NAME privilege. FĂ¤hrt Windows herunter.
EWX_FORCE
Forces processes to terminate. When this flag is set, the system does not send the WM_QUERYENDSESSION and WM_ENDSESSION messages. This can cause the applications to lose data. Therefore, you should only use this flag in an emergency. Die aktiven Prozesse werden zwangsweise und ohne RĂźckfrage beendet.
EWX_FORCEIFHUNG
Windows 2000/XP: Forces processes to terminate if they do not respond to the WM_QUERYENDSESSION or WM_ENDSESSION message. This flag is ignored if EWX_FORCE is used. Windows 2000/XP: Die aktiven Prozesse werden aufgefordert, sich selbst zu beenden und mĂźssen dies bestĂ¤tigen. Reagieren sie nicht, werden sie zwangsweise beendet.

komentarze po eng i ger bo język ćwiczyłem :D

//----------------------
www.beldzio.com
Szukam betatesterów chętnych proszę o wpisanie się na www.beldzio.com/beta
Oxi: Bełdzio - wyciągłem z kodu te opisy bo mi poszerzały 2.5 raza moniotr ;)

No to dla początkującego:
Jak było w pascalu to teraz w delphi :P

Dodaj na forme komponenty:
- Label1
- Edit1
- Button1

W Caption Labela napisz: 'Wpisz swoje imię:', a w Text komponentu Edit1 wyczyść zawartość żeby byla pusta

W onclick Button'a1 wpisz ten kod:
ShowMessage('Cześć ', Edit1.Text,'! To jest komunikat;)');

hehe to jest dla bardzo ale to bardzo początkujących :P

Anonymous AdSoftKontakt e-mail

Jak zrobić negatyw jakiejś bitmapy :?
Można napisać prostą procedurę, która zmieni odpowiednio kolory:

procedure TForm1.Button1Click(Sender: TObject); var Â x, y : integer; //1 Â r, g, b : byte; //2 begin Â if OpenDialog1.Execute then //3 Â Â Â begin Â Â Â Â Image1.Picture.LoadFromFile(OpenDialog1.FileName); //4 Â Â Â Â x := 0; Â Â Â Â y := 0; Â Â Â Â Application.ProcessMessages; Â Â Â Â while x <= Image1.Picture.Width do Â Â Â Â Â Â begin Â Â Â Â Â Â Â r := 255 - GetRValue(Image1.Canvas.Pixels[x, y]); //5 Â Â Â Â Â Â Â g := 255 - GetGValue(Image1.Canvas.Pixels[x, y]); //5 Â Â Â Â Â Â Â b := 255 - GetBValue(Image1.Canvas.Pixels[x, y]); //5 Â Â Â Â Â Â Â Image1.Canvas.Pixels[x, y] := RGB(r, g, b); //6 Â Â Â Â Â Â Â x := x + 1; Â Â Â Â Â Â Â if x = Image1.Width then Â //7 Â Â Â Â Â Â Â Â Â begin Â Â Â Â Â Â Â Â Â Â x := 0; Â Â Â Â Â Â Â Â Â Â y := y + 1; Â Â Â Â Â Â Â Â Â Â // Application.ProcessMessages; //8 Â Â Â Â Â Â Â Â Â end; Â Â Â Â Â Â Â if y - 1 = Image1.Height then //7 Â Â Â Â Â Â Â Â Â begin Â Â Â Â Â Â Â Â Â Â x := Image1.Width + 1; Â Â Â Â Â Â Â Â Â Â y := y; Â Â Â Â Â Â Â Â Â end; Â Â Â Â Â Â end; Â Â Â end; end;

Jak można zauważyć na Form1 należy wrzucić: Button1, OpenDialog1 i oczywiście Image1, a jego właściwość AutoSize ustawiamy na True.
//1: współrzędne piksela, który jest aktualnie odczytywany w pętli;
//2: wartość kolorów czerwonego®, zielonego(g) i niebieskiego(B) w odczytywanym pikselu po zmianie na negatyw.
//3: instrukcja warunkowa - jeżeli zostanie wybrany plik z OpenDialog1 to wykonaj poniższe instrukcje.
//4: ładuje obraz wybrany w OpenDialog do Image1.
//5: "odwraca" kolory.
//6: koloruje piksel o współrzędnych[x, y] na kolor zmieniony kolor(funkcja RGB(r, g, B) zmienia 3 składniowe kolory na 1 końcowy).
//7: sprawdza, czy x nie jest większy od obrazka - jeśli tak przechodzi do następnej lini;
//8: Usunięcie '//' na początku lini pozwoli na bierząco oglądać zmieny na Image1(zwiększy się jednak czas wykonywania procedury).

Dla ambitnych dodam, że zabawa wartościami r, g, b pozwoli uzyskać ciekawe efekty.
Użytkownik LewB ar edytował ten post 25 luty 2005, 14:27
Oto procedurki pozwalające zapisywać i odczytywać z pliku zawartość ListView, i innych list:
Zapis do pilku:
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction); var File: TFileStream; begin File := TFileStream.Create('nazwapliku', fmCreate or fmShareCompat); try File.WriteComponent(ListView1); finally File.Free; end; end;
Odczyt z pliku:
procedure TForm1.FormCreate(Sender: TObject); var File: TFileStream; begin if FileExists('c:telefony.lst') then begin File := TFileStream.Create('nazwapliku', fmOpenRead or fmShareDenyWrite); try File.ReadComponent(ListView1); finally File.Free; end; end else exit; end;

Otwieranie napędu CD/DVD o dowolnej literze:
procedure OpenCloseCD(Drive: string; OpenCD: Boolean); {Litera dysku musi być np. "X:", OpenCD: true = otworzyć false = zamknąć} var OpenParm: TMCI_Open_Parms; Handle: THandle; begin OpenParm.dwCallback := 0; OpenParm.lpstrDeviceType := 'CDAudio'; OpenParm.lpstrElementName := PChar(Drive); OpenParm.dwCallback := Handle; if OpenCD then begin {Otwieranie napędu CDROM} mciSendCommand(0, MCI_OPEN, MCI_OPEN_ELEMENT or MCI_OPEN_TYPE, Longint(@OpenParm)); mciSendCommand(OpenParm.wDeviceID, MCI_SET, MCI_SET_DOOR_OPEN, 0); end else begin {Zamykanie napędu CDROM} mciSendCommand(0, MCI_OPEN, MCI_OPEN_ELEMENT or MCI_OPEN_TYPE, Longint(@OpenParm)); mciSendCommand(OpenParm.wDeviceID, MCI_SET, MCI_SET_DOOR_CLOSED, 0); end; {Należy jeszcze zamknąć MCI, inaczej kolejna próba otwarcia albo zamknięcia szuflady CDROM nie powiodła by się} mciSendCommand(OpenParm.wDeviceID, MCI_CLOSE, MCI_NOTIFY, Longint(@OpenParm)); OpenCD := not OpenCD; end; procedure TForm1.Button1Click(Sender: TObject); begin OpenCloseCD(Edit1.Text + ':',true); end; procedure TForm1.Button2Click(Sender: TObject); begin OpenCloseCD(Edit1.Text + ':',false); end;

----------------
Kamil Wajda
GG: 8863160
Błagam o pomoc w rozkręceniu mojego forum: http://i.1asphost.com/kamil502/ (lub: http://www.kamil502.forum.prv.pl/ )

Wynalazłem fajny sposób na koipiowanie plików (więc się nim dziele bo ja kiedyś tego bardzo pootrzebowałem i musiałem sam wymyślić). Zapraszam do lektury ;-)

var
Abort: Boolean; //zmiena globalna przerywająca kopiowanie (dot. jednego pliku jeżeli jest więcej plików należy zrobić dotatkowy warunek
...
procedure TCopyFrm.CopyFileX(FormFile, ToFile: String; ); var FromF, ToF: file; NumRead, NumWritten: Integer; Buf: array[1..512] of Char; // odczytanie do tablicy 512 znaków (najlepiej wykorzystywać zmienną tablicę na podstawie rozmiaru pliku) begin Application.ProcessMessages; // żeby nie wyglądało na zawieszone;-) Label1.Caption:=ExtractFileName(ToFile); //wyświetlanie samej nazwy pliku AssignFile(FromF, FormFile); Reset(FromF, 1); // mały problem z plikami typu READ ONLY Application.ProcessMessages; AssignFile(ToF, ToFile); Rewrite(ToF, 1); ProgressBar1.Max:=FileSize(FromF); ProgressBar1.Step:=SizeOf(Buf); repeat Application.ProcessMessages; BlockRead(FromF, Buf, SizeOf(Buf), NumRead); Application.ProcessMessages; BlockWrite(ToF, Buf, NumRead, NumWritten); Application.ProcessMessages; if Abort = True then Break; ProgressBar1.StepIt; until (NumRead = 0) or (NumWritten <> NumRead); Application.ProcessMessages; CloseFile(FromF); CloseFile(ToF); ProgressBar1.Position:=0; end;

... i koniec!

Pozdro,
MasterLuk!

www.nasza.strefa.pl [OpenCD]

jak zmieścić w stringu więcej niż 255 znaków ?

nic trudnego wystarczy użyć zminnej AnsiString
jest o wiele lepszy od String, gdyż długość łańcucha jest praktycznie nieograniczona.

Jak pobrać kod ASCII dla każdego znaku?
Nic prostrzego: na formę wrzucamy Memo1, Button1 i w onclick Button1 piszemy:
procedure TForm1.Button1Click(Sender: TObject); var zn: Char; i: integer; begin i := 1; Memo1.Lines.Clear; while i <= 255 do begin Memo1.Lines.Add(Char(i) + ' - ' + IntToStr(i)); inc(i); end; end;

Jak bezpiecznie skonwertować zmienną łańcuchową na zmienną typu zmiennoprzecinkowego niezależnie od ustawień systemowych/regionalnych (odnośnie znaku rozpoczynającego część ułamkową (może to być . lub , )) ?
A oto odpowiedź :
function StrToFloatSaf(AStr: string; const ADefVal: Extended = 0): Extended; var Â l: integer; begin Â try Â Â Result := StrToFloat(AStr); Â except Â Â l := Pos(',', AStr); Â Â if l <> 0 then Â Â begin Â Â Â Â AStr[l] := '.' Â Â end else Â Â begin Â Â Â l := Pos('.', AStr); Â Â Â if l <> 0 then Â Â Â Â AStr[l] := ','; Â Â end; Â Â Result := StrToFloatDef(AStr, ADefVal); Â end; end;
Użytkownik HNB edytował ten post 14 marzec 2005, 15:40
jak zrobic przezroczystą formę?

AlphaBlend := True;
AlphaBlendValue := 240;

Jak zrobić zaokrąglone rogi??

To bardzo proste. Najpierw ustawiamy w Object Inspektorze własność BorderStyle na
bsNone.

Potem w zdarzeniu onCreate formy wpisujemy:
SetWindowRgn( Handle, CreateRoundRectRgn( 0,0,width,height,20,20 ),true );

Zmieniając liczby w nawiasie możemy dostosować wygląd do naszych potrzeb.
Użytkownik Zaper edytował ten post 15 marzec 2005, 20:06
Jak włączyć i wyłączyć monitor?

SendMessage(Application.Handle,wm_SysCommand,SC_MonitorPower,1); //wyłączenie monitora SendMessage(Application.Handle,wm_SysCommand,SC_MonitorPower,-1); //włączenie monitora
Użytkownik Zaper edytował ten post 19 marzec 2005, 13:08
Co wpisac, aby po kliknieciu na button/rysunek wkleil mi sie tag html (lub jakis inny:)) w synedicie. Nic trudnego:

SynEdit1.SelText:='<html> </html>'

jak zrobić autostart programu?? nic trudnego:
uses Registry; ... var Rej : TRegistry; ... Rej:=TRegistry.Create; Rej.RootKey:=HKEY_CURRENT_USER; lub HKEY_LOCAL_MACHINE Rej.OpenKey('\Software\Microsoft\Windows\CurrentVersion\Run',true) ; if not Rej.ValueExists('nazwa klucza') then Rej.WriteString('nazwa klucza','ścieżka dostępu'); Rej.CloseKey; Rej.Free; end;
pozdrowienia :)

Na forum wiele osób pyta o bazy danych, w takich wypadkach mozemy zbudowac prostą baze danych na plikach typowanych.

1. Tworzymy rekord:
type
TBaza = packed record
Name: ShortString;
Adres: ShortString;
Age: byte;
end;

2. Tworzymy deklaracje pliku w oparciu o nasz rekord:

TBazaF = file of TBaza;

3. Tworzymy tablicę - czyli baze zbudowaną z naszych rekordów.

var
MyBase: array[0..5] of TBaza; //6 elemetów tablicy

naturalnie możemy też użyć tablic dynamicznych i okreslać ich wielkość funckją SetLength;

4. Procedura zapisująca:

var
Baza: TBaza; //wskazanie na nasz redkord
BazaF: TBazeF; //wskazanie na nasz plik
i: Integer;
FName: string; //nazwa pliku
begin
FName := ExtractFilePath(Application.Exename) + 'baza.dat';
AssignFile(BazaF, FName); //przypisnie sciezki do pliku
ReWrite(BazaF); //stworzenie pliku
try
for i := 0 to High(MyBase) do //liczba przebiegów = liczba rekordów
begin
Baza.Name := MyBase[i].Name;
Baza.Adres := MyBase[i].Adres;
Baza.Age := MyBase[i].Age;
Write(BazaF, Baza); //zapisywanie kazdego rekordu
end;
finally
CloseFile(BazaF); //zamkniecie pliku
end;
end;

5. Procedura odczytująca:

var
Baza: TBaza;
BazaF: TBazaF;
i : Integer;
FName: string;
begin
FName := ExtractFilePath(Application.ExeName) + 'baza.dat';
if not FileExists(FName) then
Exit; //jesli plik nie istnieje = nie byl jeszcze zapisany, wiec konczymy procedure

AssignFile(BazaF, FName);
Reset(BazaF);
try
for I := 0 to FileSize(BaseFile) -1 do
begin
Read(BazaF, Baza);
MyBase[i].Name := Baza.Name;
MyBase[i].Adres := Baza.Adres;
MyBase[i].Age := Baza.Age;
end;
finally
CloseFile(BazaF);
end;

Oczywiście łatwo możemy taka bazę wyświetlać w TListView, edytować, dodawać usuwać rekordy - sprowadza się to do operacji na tablicach.

jak zamienić z małych na duże litery editcie??

edit1.text := UpperCase(edit1.text);
Użytkownik Asdef edytował ten post 19 kwiecień 2005, 18:31
Jak zamienić duże litery na małe?

Edit1.Text := LowerCase(Edit1.Text);

Jak wydrukować RichEdit z użyciem PrintDialog?
if PrintDialog1.Execute then RichEdit1.Print({w to miejsce wstawiamy nazwę zmienej, która wykorzystujemy do zapisywania lub otwierania(jeśli tworzysz edytor tekstu)});
Jak zmienić kolor tekstu w RichEdit z użyciem ColorDialog?
if ColorDialog1.Execute then RichEdit1.SelAttributes.Color := ColorDialog1.Color;
Jak zmienić czcionkę w RichEdit z użyciem FontDialog?
if FontDialog1.Execute then RichEdit1.Font := FontDialog1.Font;
Użytkownik delphinista007 edytował ten post 20 kwiecień 2005, 18:27
Jak sprawdzić czy podana liczba jest liczbą pierwszą?

function Sprawdz ( i : Integer): Boolean; var Â dzielnik : LongInt; begin Â Result := False; Â dzielnik := 2; Â while (( dzielnik 0 )) do Â Â inc ( dzielnik ); Â if ( dzielnik = i ) then Result := True; end;
Użytkownik jancu edytował ten post 20 kwiecień 2005, 20:40
Jak odczytać sciezki do folderów systemowych

uses ShlObj;
function GetSpecialFolderPath(const Folder: Integer): string; var Path: array[0..MAX_PATH] of Char; begin SHGetSpecialFolderPath(0, Path, Folder , False); Result := Path; end;

Przy czym zmienna Folder może mieć postać:
* CSIDL_ALTSTARTUP - programy uruchamiane wraz z systemem * CSIDL_APPDATA - Dane aplikacji * CSIDL_BITBUCKET - wirtualny folder Kosz * CSIDL_COMMON_ALTSTARTUP - wspólne programy użytkowników uruchamiane wraz ze startem systemu * CSIDL_COMMON_DESKTOPDIRECTORY - folder plików widocznych na Pulpicie każdego użytkownika * CSIDL_COMMON_FAVORITES - wspólne Ulubione wszystkich użytkowników * CSIDL_COMMON_PROGRAMS - wspólne Programy w Menu Start * CSIDL_COMMON_STARTMENU - elementy Menu Start dla wszystkich użytkowników * CSIDL_COMMON_STARTUP - Autostart dla wszystkich użytkowników * CSIDL_CONTROLS - wirtualny folder Panelu sterowania * CSIDL_COOKIES - Cookies stron internetowych * CSIDL_DESKTOP - wirtualny folder pulpitu * CSIDL_DESKTOPDIRECTORY - fizyczny folder Pulpit * CSIDL_DRIVES - wirtualny folder Mój komputer * CSIDL_FAVORITES - ulubione obiekty * CSIDL_FONTS - folder zawierający zainstalowane czcionki * CSIDL_HISTORY - łączniki do ostatnio odwiedzonych stron * CSIDL_INTERNET - wirtualny folder reprezentujący Internet * CSIDL_INTERNET_CACHE - Temporary Internet Files * CSIDL_NETHOOD - elementy wyswietlane w Otoczeniu sieciowym * CSIDL_NETWORK - wirtualny folder Otoczenia sieciowego * CSIDL_PERSONAL - Moje dokumenty * CSIDL_PRINTERS - wirtualny folder zainstalowanych drukarek * CSIDL_PRINTHOOD - repozytorium dla łączników do drukarek * CSIDL_PROGRAMS - Programy w Menu Start * CSIDL_RECENT - ostanio używane dokumenty * CSIDL_SENDTO - opcje menu "Wyślij do..." * CSIDL_STARTMENU - Menu Start * CSIDL_STARTUP - Autostart * CSIDL_TEMPLATES - Szablony

A ja dam z innej beczki, a mianowicie coś przydatnego dla osób tworzących w delphi oraz w macromedii Flash.

Jak zamienić plik Macromedia Flash w formacie SWF na wykonywalny EXE?
Należy zlinkować program Macromedia Player z plikiem SWF.
Aby to zrobićtrzeba stworzyć własną funkcję:

function Swf2Exe(PlikSWF, PlikEXE, MFlash: string): Boolean; var Zrodlo, Docelowy, Player: TFileStream; bufor: LongInt; RozmiarSWF: Integer; begin Result := False; Docelowy := TFileStream.Create(PlikEXE, fmCreate); try Player := TFileStream.Create(MFlash, fmOpenRead or fmShareExclusive); try Docelowy.CopyFrom(Player, 0); finally Bufor := Player.Size; Player.Free; end; Zrodlo := TFileStream.Create(PlikSWF, fmOpenRead or fmShareExclusive); try Docelowy.CopyFrom(Zrodlo, 0); Bufor := -99470250; Docelowy.WriteBuffer(bufor, SizeOf(Integer)); RozmiarSWF := Zrodlo.Size; Docelowy.WriteBuffer(RozmiarSWF, SizeOf(Integer)); Result := True; finally Zrodlo.Free; end; finally Docelowy.Free; end; end;

Jak zmieniać zawartość schowka (string)?

uses Clipbrd; [...] procedure schowek_zapis_tekst(text: string); begin ClipBoard.AsText:= text; //zmiana wartosci end;

Jak zmienić zawartość schowka (bitmapa) ?

uses Clipbrd; [...] procedure schowek_zapis_bitmapa(bitmap: TBitmap); begin ClipBoard.assign(Bitmap); //zapisanie end;

Uwaga! U mnie z jakiegoś powodu źle zapisywał obrazy do schowka, ale i tak daję tą procedurę, może się komuś przyda ;)

Jak wyczytać zawartość schowka (string) ?

uses Clipbrd; [...] function schowek_odczyt_tekst: string; var schowek: TClipboard; //deklaracja zmiennej begin if not ClipBoard.HasFormat(CF_TEXT) then Â showmessage('Ojojojoj!;) W schowku nie ma tekstu!') Â else Â result:= ClipBoard.AsText; //czytanie end;

Jak wyczytać zawartość schowka (bitmapa) ?

uses Clipbrd; [...] procedure schowek_odczyt_bitmapa(bitmap: TBitmap); begin if not ClipBoard.HasFormat(CF_BITMAP) then Â showmessage('W schowku nie ma bitmapy!') Â else Â bitmap.assign(ClipBoard); //zapisywanie end;
Użytkownik Kajetanek edytował ten post 21 kwiecień 2005, 15:19
Jak zrobić przyciemnianie okna
Odrazu mówie że ten kod dziaa tylko w na Windows 2000, XP.
W Object Inspektorze ustawiamy AlphaBlend na true i AlphaBlendValue na 0.
Dodajemy zmieną globalną: i: byte; .
W zdarzeniu OnCreate Formy wpisujemy: i:= 0;

Następnie na forme wstawiamy TTimer i ustawiamy Interval na 1. Klikamy podwójnie nia ikonkę timera i wstawiamy kod:
if i = 250 then begin i:= 255; end; if i <> 255 then i:= i+10; Form1.AlphaBlendValue:= i;
Użytkownik Zaper edytował ten post 22 kwiecień 2005, 18:30
Jak zapisać plik tekstowy o wybranym przez uzytkownika rozszerzeniu?

Wiele osób, piszących edytor tekstowy, napotyka problem - jak zrobić aby uzytkownik mógł zapisac sobie plik z naszego edytora o rozszerzeniu z listy. Aby tego dokonac wstawiamy sobie komponent SaveDialog i edytujemy liste Filtrów. Przykładowo:

Plik tekstowy | *.txt
Plik WordPada| *.wri
Plik konfiguracji | *.cfg

Nastepnie w kodzi przycisku odpowiedzialnego za zapis:

var
FName: string; //zmienna zawierajaca nazwe pliku
ext: string[4]; //zmienna zawierajaca rozszerzenie
begin
if SaveDialog1.Execute then
begin
FName := SaveDialog1.FileName;
{możemy też dodać linjke, która sprawi, że jesli user juz w oknie zapisu wpisze rozszerzenie to zostanie ono zignorowane : Delete(FName, Pos('.', FName), Length(FName)); }

//w zależności od wybranej pozycji z listy w Sabedialogu przypisujemy rozszerzenie
Case SaveDialog1.FilterIndex of
0: begin
RichEdit1.PlainText := False;
ext := '.txt';
end;
1: begin
richedit1.PlainText := True;
ext := '.wri';
end;
2: begin
richedit1.PlainText := False;
ext := '.cfg';
end;
end;

RichEdit1.Lines.saveToFile(FName + ext); //zapis
end;
end;

Jak zobaczyć, do czego prowadzi lnik

uses ActiveX, ComObj, ShlObj; function GetLinkInfo(FileName: string): string; var Chemin : array[0..MAX_PATH - 1] of Char; Data : TWin32FindData; Link : IShellLink; Objekt : IUnknown; PFichier : IPersistFile; WNomFichier : WideString; begin Result := ''; Objekt := CreateComObject(CLSID_ShellLink); Link := Objekt as IShellLink; PFichier := Objekt as IPersistFile; WNomFichier := FileName; PFichier.Load(PWChar(WNomFichier), STGM_READ); if Succeeded(Link.GetPath(Chemin, MAX_PATH, Data, SLGP_UNCPRIORITY)) then Result := Chemin; end;

Jak pobrac listę zainstalowanych programów (dodaj/usuń programy) a potem uruchomić jej instalator/deinstalator ?

1. Tworzymy klase zawierajaca informacje o programach oraz konstruktor:

type TDeinstall=class dNazwa, dKomenda_deinstalacji, dklucz_rejestru: string; constructor Create(Nazwa, komenda_deinstalacji, klucz_rejestru: string); end;

2. Przypisujemy kod konstruktora:

constructor TDeinstall.Create(Nazwa, komenda_deinstalacji, klucz_rejestru: string); begin dNazwa:=Nazwa; dKomenda_deinstalacji:=komenda_deinstlacji; dklucz_rejestru:=klucz_rejestru; inherited Create; end;

3. Całośc opiera się na rejestrze, a kod wyglada tak (do uses dodaj Registry; ). Dodaj na forme TListBox - do niego załadujemy liste programow :

var Reg: TRegistry; Lista: TStringList; i: Integer; DI: Tdeinstall; begin Reg:=TRegistry.Create; try Reg.RootKey:=HKEY_LOCAL_MACHINE; Reg.OpenKey('Software\Microsoft\Windows\CurrentVersion\Uninstall' ,False); Lista:=TStringList.Create; Reg.GetKeyNames(Lista); Reg.CloseKey; ListBox1.Items.BeginUpdate; for I:=0 to Lista.Count-1 do begin Reg.OpenKey('Software\Microsoft\Windows\CurrentVersion\Uninstall\ ' + Lista.Strings[I], False); if Reg.ValueExists('DisplayName') then begin DI:=TDeinstall.Create(Reg.ReadString('DisplayName'), Reg.ReadString('UninstallString'), 'Software\Microsoft\Windows\CurrentVersion\Uninstall\' + Lista.Strings[I]); ListBox1.Items.AddObject(DI.Nazwa, DI); end else begin if Reg.ValueExists('QuietDisplayName') then begin DI:=TDeinstall.Create(Reg.ReadString('QuietDisplayName'), Reg.ReadString('QuietUninstallString'), 'Software\Microsoft\Windows\CurrentVersion\Uninstall\' + Lista.Strings[I]); ListBox1.Items.AddObject(DI.Nazwa+ ' [Warning: Quiet mode detected]', DI); end end; reg.CloseKey; end; ListBox1.Items.EndUpdate; finally Reg.Free; end;

4. wywołanie deinstalatora mozemy zrobic tak:

var Command: String; begin Command:=(ListBox1.Items.Objects[ListBox1.ItemIndex] as TDeinstall).dKomenda_deinstalacji; WinExec(PChar(Command), SW_SHOW); end;

Jak wyświetlić wszystkie dyski:

var i : integer; Drive_Type : integer; begin for i := Ord('A') to Ord('Z') do begin Drive_Type := GetDriveType(PChar(Chr(i) + ':\')); If (Drive_Type <> 0) and (Drive_Type <> 1) then begin ListBox1.Items.Add(Chr(i) + ':'); end; end;

Jak pobrać listę wartości danego klucza w rejestrze?

Do listy uses dodajemy Registry, a na forme wstawiamy TMemo , który nazywamy MemoTMP

procedure Pobierz(klucz: String); var Reg: TRegistry; begin Reg:= TRegistry.Create; if Reg.OpenKey(klucz, False) then Reg.GetValueNames(MemoTmp.Lines); end;

Jak sprawdzić jakie atrubuty ma dany plik?

Używamy funkcji FileGetAttr();

var fName: string; AttrByte: integer; begin FName := 'C:\plik.exe'; AttrByte := FileGetAttr(fname); if AttrByte and faReadOnly = faReadOnly then ShowMessage('ten plik ma atrybut Tylko do odczytu'); if AttrByte and faHidden = faHidden then ShowMessage('Tem plik ma atrybut Ukryty'); if AttrByte and faSysFile = faSysFile then ShowMessage('Ten plik ma atrybut Systemowy'); if AttrByte and faArchive = faArchive then ShowMessage('Ten plik ma atruybut Archiwalny'); end;

Jak nadac atrybut plikowi?

var AttrByte: integer; fname: string; begin AttrByte := 0; //brak atrybutów AttrByte := AttrByte or faReadOnly; //nadanie atrybutu Tylko do odczytu AttrByte := AttrByte or faHidden; //nadanie atrybutu Ukryty AttrByte := AttrByte or faSysFile; //atrubut Systemowy AttrByte := AttrByte or faArchive; //atrybuit Archiwalny FileSetAttr(fname, AttrByte); //zapisanie end;

W jaki sposób wyszukać jakąś wartość w komponencie ListView?

ListView.Selected := ListView.Items[-1]; for I := 0 to ListView.Items.Count -1 do begin if Pos(edtSearch.Text, ListView.Items[i].Caption) > 0 then begin ListView.SetFocus; ListView.Selected := ListView.Items[i]; ListView.Scroll(0, (ListView.Items[i].Top) - 100); end; end;

Jak zaszyfrować tekst ?

Uzyję prostego bardzo prostego algorytmu. Oczywiście możesz go urozmaicić.

function Szyfruj(tekst, haslo : String) : String; var I: Integer; //aktualna pozycja w tekscie PassCount : Integer; //aktyalna pozycja znaku hasła begin PassCount := 0; //zaczynamy od zera Result := sString; for I := 1 to Length(sString) do //literacja; ilosc przebiegów = ilosc znaków w tekscie begin Result[i] := Chr(Ord(sString[i]) xor Ord(Password[PassCount])); //zamienienie danego znaku na jego odpowiednik liczbowy - Ord(); i sksorowanie go znakiem hasła, i na koniec przerobienie spowrotem na tekst - Chr(); Inc(PassCount); //zwiekszenie numeru znaku w hasle if PassCount > Length(Password) then PassCount := 0; // Jezeli licznik przekroczy dlugosc hasla - wyzeruj end; end;

wywoałnie tego wyglada tak:
var tekst: string; begin tekst := Szyfruje('tekst do zaszyfrowania','bardzo trudne hasło'); ShowMessage(tekst); end;
Użytkownik programista1101 edytował ten post 30 kwiecień 2005, 17:58
Jak przekierować port: Dajemy komponnet IdMappedPortTCP1 z Indy Servers.
IdMappedPortTCP1.DefaultPort := StrToInt(Edit1.Text); //port do zmienienia IdMappedPortTCP1.MappedHost := Edit2.Text;//komputer na którym ma być przekierowanie IdMappedPortTCP1.MappedPort := StrToInt(Edit3.Text);//na ten port będzie przekierowanie
Użytkownik Matpien3 edytował ten post 30 kwiecień 2005, 19:12
Jak zaszyfrować/rozszyfrować plik? (użycie MMX :D)procedure Szyfruj(plik:string); var ff:file; b:pointer; c, r:integer; const d:array[0..7]of char = #4#4#4#4#4#4#4#4; begin getmem(b,16384); AssignFile(ff,plik); Rewrite(ff,1); while not eof(f) do begin BlockRead(f,b^,16384,r); asm xor ecx,ecx @l: mov eax,b movq mm0,qword ptr ds:dword ptr ds:[eax]+8*ecx paddb mm0,qword ptr ds:[d] movq qword ptr ds:dword ptr ds:[eax]+8*ecx,mm0 inc ecx cmp ecx,2048 jne @l end; BlockWrite(ff,b^,r); end; freemem(b ); closefile(f); closefile(ff); end; procedure Rozszyfruj(plik:string); var ff:file; b:pointer; c, r:integer; const d:array[0..7]of char = #4#4#4#4#4#4#4#4; begin getmem(b,16384); AssignFile(ff,plik); Rewrite(ff,1); while not eof(f) do begin BlockRead(f,b^,2048,r); asm xor ecx,ecx @l: mov eax,b movq mm0,qword ptr ds:dword ptr ds:[eax]+8*ecx psubb mm0,qword ptr ds:[d] movq qword ptr ds:dword ptr ds:[eax]+8*ecx,mm0 inc ecx cmp ecx,2048 jne @l end; BlockWrite(ff,b^,c); end; closefile(f); closefile(ff); end;
Użytkownik Cyrkiel edytował ten post 01 sierpień 2005, 22:08
Jak korzystac z TIdTCPClient i TIdTCPServer?

Serwer (nasluch):

IdTCPServer1.Active:= true;//wlaczenie IdTCPServer1.Active:= false;//wylaczenie

Klient (laczenie):

procedure polacz(host: string; port: integer); begin IdTCPClient1.Host:= host; Â //adres ip lub dns IdTCPClient1.Port:= port; Â Â //nr portu IdTCPClient1.Connect(120); //polaczenie end;

Klient (wysylanie):

function wyslij(tekst: string) : boolean; begin if not IdTCPClient1.Connected then begin Result:= false; exit; end; IdTCPClient1.WriteLn(tekst); end; [B]Serwer (polaczenie jednowatkowe):[/B] [CODE] var Thread: pointer; //w interface [...] //w serwer OnConnect begin Thread:= AThread; AThread.Connection.WriteLn('Witamy!'); ShowMessage('Polaczono...'); end;

Serwer (rozlaczenie jednowatkowe):

//w serwer OnDisconnect begin Thread:= nil; ShowMessage('Rozlaczono...'); end;

Serwer (odbior):

//w serwer OnExecute var msg: string; begin msg:= Â AThread.Connection.ReadLn;//odbior ShowMessage(msg); end;

Serwer (wysylanie jednowatkowe):

function wyslij_serwer(tekst: string) : boolean; begin if Thread=nil then begin Result:= false; exit; end; TIdPeerThread(Thread).Connection.WriteLn(tekst); end;

Klient (odbior):

//w Timerze OnTimer (interval na 500 milisek) begin if not IdTCPClient1.Connected then exit; msg:= klient.ReadLn('', 5); if msg='' then exit else ShowMessage(msg); end;

Klient (rozlaczenie):

IdTCPClient1.Disconnect;

Serwer (rozlaczenie):

TIdPeerThread(Thread).Connection.Disconnect; //lub Terminate
Użytkownik Kajetanek edytował ten post 03 maj 2005, 13:27
Jak za pomocą TServerSocket obsłużyć wiele wątków (np. pisząc komunikator) :

Var Watek : Integer; Begin Try For Watek := 0 to ServerSocket1.Socket.ActiveConnections-1 do // instrukcje Except Form1.Color := clWhite // chodzi o to, że wyświetla błąd ale wykonuję instrukcję więc posłużywłem się try, a w except pisze warunek na 100% spełniony by użytkownik nie zauważył zmiany
Użytkownik Matpien3 edytował ten post 04 maj 2005, 17:23
Jak obsluzyc wiele watkow w TIdTCPServer?

//jest kilka sposobow na to. Moim zdaniem najwygodniejszy jest z uzyciem pointerow [...] var watki: TList; [...] //w OnConnect begin watki.Items.Add(AThread); end;

Jak wyslac tekst do jendengo z watkow?

begin TIdPeerThread(watki.Items[0]).Connection.WriteLn('To jest wyslany tekst'); end;

Jak narysować losowe wygięte linie takie jak w paincie:

var p: Array of TPoint; i: Integer; begin SetLength(p, 4); for i := Low(p) to High(p) do begin p[i].x := Random(Width); p[i].y := Random(Height); end; Canvas.PolyBezier(p); end;

Jak wyczytac np. 8 litere 7 linii w memo??

jakis_char:= Memo1.Lines[7+1][8];

//Edit
Do mojego kodu wkradl sie blad... dry.gif Dzieki Cyrkiel za pomoc... happy.gif
Użytkownik Kajetanek edytował ten post 13 listopad 2005, 10:21
Jak skopiować fragment stringu do innego:

var source, dest : string; begin source := '123456789'; dest := '---------'; Move(source[1], dest[2], 2); \\ source: od którego znaku, dest: od której lini wkleić, i ostatnie do której lini skopiować w source ShowMessage('Source = '+source); ShowMessage('Dest = '+dest);

P.S Musiałem coś napisać by Ci odpowiedzieć, bo inaczej to by niebyło FAQ.
P.S Ok już masz mnie nie gonić. :D Ja też nie będe cię ju ż gonił :D

Ten FAQ bedzie mial raczej znaczenie leksyklane, ponieważ wiele osob pyta o co chodzi jak się mu pojawi jakis tam wyjatek, zamieszczam tu opis wyjątków:

Exception - Klasa bazowa dla wysztkich wyjątków
EAbort - Tzw. "cichy wyjątek"
EAccessViolation - Dostęp do zabrionionego obszaru pamięci
EBitsError - Niewłaściwe indeksowanie właściwości Bits obiektu TBits
EComponentError - Zmiana nazwy komponentu na nieprawidłową
EControlC - Naciśnięto [CTRL]+[C] w aplikacji konsolowej
EConvertError - Błąd podczas konwersji StrToFloat lub StrToInt

EExternalException - Kod wyjątku nie pasuje do listy kodów
EInOutError - Błąd wejścia/wyjścia (operacji na pliku). Zawiera pole ErrorCode.*
EIntError - Błędy liczb całkowitych
EDivByZero - Dzielenie przez zero liczby całkowitej
EIntOverflow - Nadmiar przy liczbach całkowitych
ERangeError - Przekroczenie zakresu zmiennej całkowitej lub tablicy
EInvalidCast - Błąd podczas konwersji operatorem as
EInvalidGraphic - Błędny format ładowanego pliku graficznego
EInvalidGraphicOperation - Niedozwolona operacja graficzna

EInvalidOperation - Niedozwolona operacja na komponencie
EInvalidPointer - Błędna operacja na zmiennej wskaźnikowej lub obiekcie
EListError - Błąd podczas operacji na łańcuchu, TList, TStrings lub TStringList

EMathError - Błędy operacji mamtematycznych zmiennoprzecinkowych
EInvalidOp - Błędna operacja arytmetyczna np. wyciąganie pierwiastka z liczby ujemnej
EInvalidArgument - Błędny argument w funkcji modułu Math
EOverflow - Nadmiar przy liczbach zmiennoprzecinkowych
EUnderflow - Zbyt mała wartość liczby zmiennoprzecinkowej jest zaokrąglana do 0
EZeroDivide - Dzielenie przez 0 liczby zmiennoprzecinkowej
EMenuError -Błędna operacja na elementach menu

EOutOfMemory - Za mało wolnej pamięci
EOutOfResources - Za mało zasobów systemowych - nie można przydzielić uchwytu

EPrinter - Błąd podczas drukowania
EPrivilege - Nieprawidłowy rozkaz maszynowy dla danego poziomu pracy procesora
EPropertyError - Niedozwolona wartość właściwości
EPropReadOnly - Próba zapisu właściwości tylko do odczytu
EPropWriteOnly - Próba odczytu właściwości tylko do zapisu
EResNotFound - Metoda ReadComponentRes nie może znaleźć zasobu
EStackOverflow - Za mało pamięci aby powiększyć dynamicznie rozmiar stosu
EStreamError - Błąd strumienia

EFCreateError - Błąd podczas tworzenia pliku
EFOpenError - Próba otwarcia obiektu strumienia pliku, który nie może zostać otwarty
EStringListError - Błąd podczas dostępu do elementów TStrings lub TStringList
EThread - Błąd wątku
ETreeViewError - Błąd komponentu drzewa TreeView
EVariantError - Błąd związany z typem Variant

* - wyjątek In/Out posiada ErrorCode, dzieki któremu moży dowiedzieć sie wiecej o błedzie. Pole to może przyjmować takie wartości:

0 - Operacja zakończona sukcesem
2 - Nie znaleziono pliku
3 - Nie znaleziono ścieżki
4 - Zbyt wiele otwartych plików
5 - Zabroniony dostęp do pliku
6 - Błędna operacja
12 - Niewłaściwy dostęp
15 - Błędne oznaczenie napędu
16 - Niewykonalne usunięcie katalogu
17 - Niewykonalna zmiana nazwy pliku
18 - Nie znaleziono pliku
19 - Plik zabezpieczono przed zapisem
21 - Plik niegotowy do operacji (np. brak dyskietki w stacji)
25 - Błędna pozycja w pliku (procedura Seek)
29 - Błąd zapisu
30 - Błąd odczytu
32 - Plik jest już otwarty, niemożliwy wspólny dostęp do pliku
33 - Zablokowany dostęp do pliku
34 - Błąd dysku
39 - Dysk jest pełny
100 - Błąd odczytu z dysku
101 - Błąd zapisu na dysk
102 - Nie skojarzono zmiennej plikowej z pliem fizycznym
103 - Nie otwarty plik
104 - Nie otwarty plik do operacji wejścia
105 - Nie otwarty plik do operacji wyjścia
106 - Nieprawidłowa dana liczbowa dla operacji wejścia
150 - Dysk zabezpieczony przed zapisem
151 - Nieznane urządzenie
152 - Napęd nie jest gotowy
153 - Nieznane polecenie
154 - Błędna dana
155 - Błędne oznaczenie napędu
156 - Błąd podczas przeszukiwania dysku
157 - Nieznany typ urządzenia
158 - Nie znaleziony sektor
160 - Błąd urządzenia dla operacji wyjścia
161 - Błąd urządzenia dla operacji wejścia
162 - Awaria sprzętu

Suplement:
Przed wyjątkami naturalnie bronimy sie tak:
try .. except on EConvertError do ... end;
unikajmy takiej obrony:
try ... except E:Exception do ...
Powoduje ona reakcję na każdy z wyjatków, także wszytskie errorCode z błedów I/O.
Po drugie zanim siegniemy po try...except lepiej załatwić sprawę (w miarę mozliwości) warunkami. Np. czestym błedem jest "List index out of bounds (X)". Zamiast od razu zabezpieczac się przed nim wyjątkiem on EListError lepiej na warunkach sprawdzić czy dana lista nie jest pusta, czy nie brakuje elementu itp.

Błędy pojawiające się podczas wykonywania programu powodują przerwanie działania programu i wyświetlenie komunikatu:

Run-time error nnn at xxxx:yyyy

gdzie nnn przedstawia numer błędu, natomiast xxxx:yyyy adres wystąpienia błędu
-------------------------------------------
Mimo iż nie jest to bardzo dokładny opis wyjatków, mam nadzieję, że stanie sie punktem gdzie uzytkownik pierw zasiegnie pomocy.
Użytkownik programista1101 edytował ten post 05 maj 2005, 15:59
Jak wyświetlić systemowe okno "Właściwości" dla wybranego elementu?
uses ShellApi; procedure Wlasciwosci(path:PChar); var ShellInfo:PSHELLEXECUTEINFOA; begin new(ShellInfo); ShellInfo.cbSize := sizeof(SHELLEXECUTEINFO); ShellInfo.fMask := SEE_MASK_NOCLOSEPROCESS or SEE_MASK_INVOKEIDLIST or SEE_MASK_FLAG_NO_UI; ShellInfo.Wnd := handle; ShellInfo.lpVerb := 'Properties'; ShellInfo.lpFile := path; ShellInfo.lpParameters := nil; ShellInfo.lpDirectory := nil; ShellInfo.nShow := SW_SHOW; ShellInfo.hInstApp := 0; ShellInfo.lpIDList := nil; ShellExecuteEx(ShellInfo); end;

Wczesniej opisałem wyjatki. Teraz też cos praktycznego, mianowicie spotkałem się z pytaniami o kody klawiszy (używanych w zdarzeniach onkeyup i onkeydown). Zmienna Key: WORD może miec takie wartości stałej lub liczbowej:

vk_LButton/1 - lewy klawisz myszy
vk_RButton/2 - prawy klawisz myszy
vk_Cancel/3 - CTRL+BREAK
vk_MButton/4 - środkowy klawisz myszy
vk_Back/8 - BACKSPACE
vk_Tab/9 - TAB
vk_Clear/12 - klawisz 5 w bloku numerycznym przy wyłączonym NumLocku
vk_Return/13 - ENTER
vk_Shift/16 - jaki kolwiek SHIFT - nie ma wpływu na wilekośc liter
vl_Control/17 - dowolny CTRL
vk_Menu/18 - dowolny ALT
vk_Pause/19 - PAUSE/BREAK
vk_Capital/20 - CAPS LOCK
vk_Escape/27 - ESC
vk_Space/32 - spacja
vk_Prior/33 - PAGE UP
vk_Next/34 - PAGE DOWN
vk_End/35 - END
vk_Home/36 - HOME
vk_Left/37 - strzałka w lewo
vk_Up/38 - sztrzałka w góre
vk_Right/39 - strzałka w prawo
vk_Down/40 - strzałka w dół
vk_SnapShot/44 - PRINT SCREEN
vk_Insert/45 - INSERT
vk_Delete/46 - DELETE
vk_Help/47 - HELP
vk_LWin/91 - lewy WINDOWS
vk_RWin/92 - prawy WINDOWS
vk_Apps/93 - menu konmtekstowe (obok prawego Windowsa)

vk_NumPad0/96 - 0 na klawiaturze numerycznej
....
vk_NumPad9/105 - 9 na klawiaturze numerycznej
vk_Multiply/106 - * na klawiaturze numerycznej
vk_Add/107 - + na klawiaturze numerycznej
vk_Substract/109 - - (minus) na klawiaturze numerycznej
vk_Decimal/110 - . (kropka) na klawiaturze numerycznej przy włączonym NumLocku
vk_Divide/111 - / na klawiaturze numerycznej
vk_F1/112 - F1
.....
vk_F24/135 - F24

vk_NumLock/144 - NUM LOCK
vk_Scroll/145 - SCROLL LOCK
vk_LShift/160 - lewy SHIFT - nie ma wpływu na wielkość liter
vk_RShift/161 - prawy SHIFT - nie ma wpływu na wielkość liter
vk_LControl/162 - lewy CTRL
vk_RControl/163 - prawy CTRL

Kody klawiszy numerycznych (tych pod serią klawiszy F) oraz liter. Wielkośc liter jest zależna od parametry ShiftStste, którego wartości opisze poźniej. Wartośc Key przyjmuje w tym momencie tylko wartości liczbowe.

48 - klawisz 0
49 - klawisz 1
....
57 - klawisz 9
65 - klawisz A
66 - klawisz B
...
90 - klaiwsz Z

W zdarzeniach onkeydown i onkeyup jest także parametr TShiftState. Okresla on wartosci klaiszy funkcyjnych i ma wpływ na to czy litera bedzie duża, czy bedzie cyfra czy symbol nad nią itp. Może on przyjąc nastepujące wartości (nie przyjmuje wartości liczbowych):

ssShift - SHIFT
ssAlt - ALT
ssCtrl - CTRL
ssLeft - Lewy klawisz myszy
ssMiddle - Środkowy klawisz myszy
ssRight - Prawy klawisz myszy
ssDouble - Lewy i prawy klawisz myszy

Parametr TShiftState nalezy trakowac jako zbiór. Jego elemeny można traktowac operatorami logicznymi.

Niektórym nie chodzi drukowanie za pomocą Richedita
Znam lepszy sposób :P
Wykorzystanie funkcji drokowania z notatnika lub worda

Oczywiscie wczesciej dodajemy do uses Shellapi
ShellExecute(Handle,'print','piwko.txt',nil, nil, SW_HIDE);
Pozdrowienia!

A teraz coś innego.
Jak to jest naprawdę z tymi string'ami??
Wiele osób mówi, że string ma 255 znaków. Tak naprawdę jest to albo ShortString (który ma maksymalnie 255 znaków), albo AnsiString (który ma teoretycznie nieograniczoną długość). To czy string jest AnsiStringiem, czy ShortStringiem zależy od przełącznika kompilatora. Robi to się za pomocą $H
Na przykład: var {$H-} S1 : String // zmienna S1 jest typu ShortString {$H+} S2 : String // zmienna S2 jest typu AnsiString
Nie mylić Stringa z zmienną typu WideString, która przechowuje ciągi znaków Unicode, a nie ASCII.

Jak to jest naprawdę z tymi string'ami cz. II

Nawiązując do poprzedniego postu dodam jesze kilka rzeczy (dla bardzo poczatkujących):

Łańcuch ShortString - jak już zostało wspomniane - może zawierać max 255 znaków. W pamięci zajmuje on 256 bajtów, ponieważ w przeciwieństwie do innyhch typów łańcuchów zawiera on tzw. zerowy ogranicznik jest to bajt, który zawiera informacje o długości łańcucha - posiada on index 0. Tak więc:

var S: ShortString; dlugosc: integer; begin S := 'Ala ma kota'; dlugosc := Ord(s[0]); end;

Zmienna 'dlugosc' zawiera teraz dlugosc łancucha, czyli 11. Na długim łańcuchu (domyslnie - string) musielibysmy uzyć funkcji Length, ponieważ kompilator zasygnalizowałby nam bła przy zapisie S[0], gdyby zmienna s: string;.
Nie jest to jedyna systuacja do której możemy z łatwością wykorzystać ogranicznik zerowy. Za pomocą operacji na tym bajcie, możemy edytować długośc łańcucha. Wszystko to dzieki, temu że bajty w tym łańcuchu mają z góry określone miejsce w pamięci, czego nie można powiedziec o innych łancuchach. Przykład:

S := 'Koszalin'; S[0] := #3;
od tego momentu zmienna S (shortString) zawiera napis 'Kos'. Abyt to samo wykonac na innych łacuchach musielibysmy napisac tak:

Copy(S, 0, 3); lub Delete(s, 3, Length(s));

Zarządzanie pamięcią na potrzeby długich łańcuchów, jest automatyczne, jednak możemy sami się z tym pobawić. Nie ma tu dużego pola do pospiu - jedyne co możemy zrobić, to zredukowac ilość zajmowanej pamięci karygodnie do długości łańcucha, np:

SetLength(S, Length(10)); //s: string

Jak już napisał KSMłody, łancuchy WideString operuja na znakach UNICODE - dwubajtowych. Ich długość także jest nieograniczona, jednak kiedy ich używac? Otóż te łancuchy znajdują zastosowanie w funkcjach OLE.

Teraz może wyjaśnienie czym jest PChar. Otóż jak wiemy Windows jest napisany w C. W jezykach C/C++ łańcuchy to ciąg znaków zakończony znakiem NULL. Tak więc funkcje API także w parametrach wymagają tego NULL - czyli znaku zerowego. Pchar jest własnie "dodaniem" tego znaku do łańcucha. Opamiętać nalezy że Pchar nie używa się do krótkich łańcuchów ShortString.
Użytkownik programista1101 edytował ten post 09 maj 2005, 15:23
Jak przesunać kursor po wstawieniu czegoś SelTextem do SynEdit?
synedit1.SelText="<TD></TD>"; synedit1.CaretX-=5;
Ma to zastosowanie w edytorach HTML

Jak otrzymać kolor w formacie do HTML :

Na formatke wrzucamy :
1x Label (Standard)
1x ColorDialog (Dialogs)
var r,g,b:byte; kolor:string; begin if Colordialog1.Execute then begin r:=getrvalue(Colordialog1.Color); g:=getgvalue(Colordialog1.Color); b:=getbvalue(Colordialog1.Color); kolor:='#'+inttohex(r,2)+inttohex(g,2)+inttohex(b,2); label1.Caption:=kolor; end;

[FAQ] Delphi tu są pytania z odpowiedziami z delphi

Ĺadny brzuch

Tematy

Ĺadny brzuch